home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / NRPAS13.ARJ / RKQC.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  56 lines
  1. PROGRAM d15r3(input,output);
  2. (* driver for routine RKQC *)
  3. CONST
  4.    n=4;
  5. TYPE
  6.    glarray = ARRAY [1..n] OF real;
  7.    glnarray = glarray;
  8. VAR
  9.    eps,hdid,hnext,htry,x : real;
  10.    i : integer;
  11.    y,dydx,yscal : glarray;
  12.  
  13. (*$I MODFILE.PAS *)
  14. (*$I BESSJ0.PAS *)
  15.  
  16. (*$I BESSJ1.PAS *)
  17.  
  18. (*$I BESSJ.PAS *)
  19.  
  20. PROCEDURE derivs(x: real; y: glarray; VAR dydx: glarray);
  21. (* Programs using derivs must define type
  22. TYPE
  23.    glarray = ARRAY [1..4] OF real; *)
  24. BEGIN
  25.    dydx[1] := -y[2];
  26.    dydx[2] := y[1]-(1.0/x)*y[2];
  27.    dydx[3] := y[2]-(2.0/x)*y[3];
  28.    dydx[4] := y[3]-(3.0/x)*y[4]
  29. END;
  30.  
  31. (*$I RK4.PAS *)
  32.  
  33. (*$I RKQC.PAS *)
  34.  
  35. BEGIN
  36.    x := 1.0;
  37.    y[1] := bessj0(x);
  38.    y[2] := bessj1(x);
  39.    y[3] := bessj(2,x);
  40.    y[4] := bessj(3,x);
  41.    dydx[1] := -y[2];
  42.    dydx[2] := y[1]-y[2];
  43.    dydx[3] := y[2]-2.0*y[3];
  44.    dydx[4] := y[3]-3.0*y[4];
  45.    FOR i := 1 to n DO BEGIN
  46.       yscal[i] := 1.0
  47.    END;
  48.    htry := 0.1;
  49.    writeln('eps':8,'htry':13,'hdid':12,'hnext':13);
  50.    FOR i := 1 to 15 DO BEGIN
  51.       eps := exp(-i);
  52.       rkqc(y,dydx,n,x,htry,eps,yscal,hdid,hnext);
  53.       writeln(eps:13,htry:8:2,hdid:14:6,hnext:12:6)
  54.    END
  55. END.
  56.